(*******************************************************************************
* API for CRON time format processing.                                         *
*******************************************************************************)
unit Cron;

interface

uses Windows;

type
  TCronSet = set of 0..59;
  TCronGroups = (crSec, crMin, crHour, crDay, crMonth, crDoW);

  TCron = class
  private
    Groups : array[TCronGroups] of TCronSet;
  public
    procedure Init(CronMask : shortstring);
    function IsCron(const CheckTime: TSYSTEMTIME) : boolean;
    procedure GetLastCronTime(var Time : TSYSTEMTIME);
    procedure GetNextCronTime(var Time : TSYSTEMTIME);
  end;

function IsEqualTime(const T1,T2 : TSYSTEMTIME) : boolean;

implementation

uses SysUtils;

// Check equivalence of time T1 and T2 (seconds-months)
function IsEqualTime(const T1,T2 : TSYSTEMTIME) : boolean;
  begin
    result := (T1.wMonth  = T2.wMonth)  and
              (T1.wDay    = T2.wDay)    and
              (T1.wHour   = T2.wHour)   and
              (T1.wMinute = T2.wMinute) and
              (T1.wSecond = T2.wSecond);
  end;

// Get first word from Src to delimiter, put into result,
// return remainder im Src
function GetWord(var Src : shortstring; Delim : char) : shortstring;
  var p : integer;
  begin
    p := pos(Delim, Src);
    if p <> 0 then
      begin
        result := copy(Src, 1, p-1);
        delete(Src, 1, p);
      end
    else
      begin
        result := Src;
        Src := '';
      end;
  end;

// Convert number string (non blank) to set,
// return true when end of line,
// remainder in Src
function ParseGroup(var Group : TCronSet; var Src : shortstring) : boolean;
  var GSrc,VSrc,NSrc : string[63];
      Step,Last,Item,e : integer;
  begin
    result := true; if Src = '' then exit;
    gsrc := GetWord(Src, ' ');
    if pos('*', gsrc) = 0 then
      begin
        Group := [];
        while gsrc <> '' do
          begin
            vsrc := GetWord(gsrc, ',');
            nsrc := GetWord(vsrc, '+');
            val(vsrc, step, e);
            vsrc := GetWord(nsrc, '-');
            val(nsrc, last, e);
            if (e <> 0) and (Step <> 0) then Last := 59;
            val(vsrc, item, e);
            if Step = 0 then Step := 1;
            repeat
              if item > 59 then break;
              include(Group, Item);
              inc(Item, Step);
            until Item > Last;
          end;
      end;
    result := Src = '';
  end;


(*** TCron object ***)

procedure TCron.Init(CronMask : shortstring);
  var i : TCronGroups;
  begin
    fillchar(Groups, sizeof(Groups), $FF);
    for i := crSec to crDoW do
      if ParseGroup(Groups[i], CronMask) then break;
  end;

function TCron.IsCron(const CheckTime: SYSTEMTIME) : boolean;
  begin
    result := (CheckTime.wSecond in Groups[crSec]) and
              (CheckTime.wMinute in Groups[crMin]) and
              (CheckTime.wHour in Groups[crHour]) and
              (CheckTime.wDay in Groups[crDay]) and
              (CheckTime.wMonth in Groups[crMonth]) and
              (CheckTime.wDayOfWeek in Groups[crDoW]);
  end;

type TTimeArray = array[0..7] of word;
const TimeNdx : array[TCronGroups] of byte = (6,5,4,3,1,2);
const GLim : array[TCronGroups] of record Lo,Hi : byte end =
  ( (Lo:0; Hi:59), (Lo:0; Hi:59), (Lo:0; Hi:23),
    (Lo:1; Hi:31), (Lo:1; Hi:12), (Lo:0; Hi:6) );

procedure TCron.GetLastCronTime(var Time : TSYSTEMTIME);
  var ICnt,MCnt : integer; Borrow : Boolean;
  procedure DecItem(var Group : TCronSet; var Item : word;
                    Min : integer);
    var i : integer;
    begin
      inc(ICnt); i := Item;
      if (i in Group) and not Borrow then exit;
      repeat
        Borrow := i <= Min; if Borrow then break;
        dec(i);
      until i in Group;
      if i <> Item then MCnt := ICnt-1;
      if Borrow then MCnt := ICnt
      else Item := i;
    end;
  function ToMaxItem(var Group : TCronSet; var Item : word;
                      Min,Max : integer) : boolean;
    var i : integer;
    begin
      i := Max;
      repeat
        if i in Group then break;
        dec(i);
      until i <= Min;
      Item := i; dec(MCnt);
      result := MCnt = 0;
    end;
  function GetHiLimit(iGroup : TCronGroups) : byte;
    begin
      if iGroup = crDay then
        result := MonthDays[IsLeapYear(Time.wYear), Time.wMonth]
      else result := GLim[iGroup].Hi;
    end;
  var i : TCronGroups;
      Times : TTimeArray absolute Time;
  begin
    ICnt := 0; MCnt := 0; Borrow := false;
    for i := crSec to crMonth do
      DecItem(Groups[i], Times[TimeNdx[i]], GLim[i].Lo);
    if Borrow then dec(Time.wYear);
    if Borrow or (MCnt <> 0) then
      for i := crSec to crMonth do
        if ToMaxItem(Groups[i], Times[TimeNdx[i]], GLim[i].Lo, GetHiLimit(i)) then
          break;
  end;

procedure TCron.GetNextCronTime(var Time : TSYSTEMTIME);
  var
    Carry : Boolean;
  function IncItem(var Group : TCronSet; var Item : word;
                    Min,Max : integer) : boolean;
    var i : integer;
    begin
      i := Item;
      result := not ((i in Group) and not Carry);
      if not result then exit;
      Carry := false;
      repeat
        if i >= Max then
          begin
            if Carry then break;
            i := Min;
            Carry := true;
          end
        else inc(i);
      until i in Group;
      Item := i;
    end;
  procedure ToMinItem(var Group : TCronSet; var Item : word; Min,Max : integer);
    var i : integer;
    begin
      i := Min;
      repeat
        if i in Group then break;
        inc(i);
      until i >= Max;
      Item := i;
    end;
  function GetHiLimit(iGroup : TCronGroups) : byte;
    begin
      if iGroup = crDay then
        result := MonthDays[IsLeapYear(Time.wYear), Time.wMonth]
      else result := GLim[iGroup].Hi;
    end;
  var
    i,IncLevel : TCronGroups;
    Modified : boolean;
    Times : TTimeArray absolute Time;
  begin
    Carry := false; Modified := false; IncLevel := crSec;
    for i := crSec to crMonth do
      if IncItem(Groups[i], Times[TimeNdx[i]], GLim[i].Lo, GetHiLimit(i)) then
        begin
          Modified := I > crSec; IncLevel := I;
        end;
    if Carry then inc(Time.wYear);
    if Modified then for i := crSec to Pred(IncLevel) do
      ToMinItem(Groups[i], Times[TimeNdx[i]], GLim[i].Lo, GetHiLimit(i));
  end;

end.
